home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacWorld 1997 August
/
Macworld (1997-08).dmg
/
Shareware World
/
Info
/
For Developers
/
SC Basic
/
Example Programs
/
File Info
/
FileInfo.bas
< prev
next >
Wrap
BASIC Source File
|
1997-06-17
|
9KB
|
270 lines
Global EventRecord As Structure
Global event_what As Word
Global event_message As Integer
Global event_when As Integer
Global event_where As Integer
Global event_modifiers As Word
Endstruct
Global DialogPtr As Integer
* Main entry point
Do Initialise
Do Process_File
Do Event_Loop
End
*********************************************************
* *
* Initialise *
*********************************************************
Procedure Initialise()
Local Gash As Integer
* GetAppCount returns the number os files dropped onto this
* application. Reject if none dropped.
If GetAppCount()=0
Gash=MsgBox("Drag a file onto the"+Chr(13)+"Fileinfo application","Ok","")
End
Endif
* Create dialog box from DLOG resource 150
DialogPtr=_GetNewDialog(Word(150),0,-1)
Return
*********************************************************
* *
* Event Loop *
*********************************************************
Procedure Event_Loop()
Local Done As Integer
Local gotEvent As Byte
Done=0
Repeat
* Wait for an operating system event to occur
gotEvent=_WaitNextEvent(Word(-1),EventRecord,0,0)
* ignore null events
If Integer(gotEvent)<>0 Then
Do DoEvent(Byref(Done))
Endif
Until Done
Return
*********************************************************
* *
* Do Event *
*********************************************************
Procedure DoEvent(Done)
Parameter Done As Integer Byref
Local what As Integer
what=Integer(event_what)
Do Case
Case what=1 'mouseDown
Do DoMouseDown(Byref(Done))
Break
Case what=6 'updateEvt
Do UpdateEvent
Endcase
Return
*********************************************************
* *
* Mouse Down *
*********************************************************
Procedure DoMouseDown(Done)
Parameter Done As Integer Byref
Local part As Integer
Local thisWindow As Integer
part=Integer(_FindWindow(event_where,Varptr(thisWindow)))
Do Case
Case part=3 'inContent
Do MouseDownInWindow(thisWindow,Byref(Done))
Case part=4 'inDrag
Do DragWindow(thisWindow)
Endcase
Return
*********************************************************
* *
* Drag Window *
*********************************************************
Procedure DragWindow(thisWindow)
Parameter thisWindow As Integer
Local GrayRgnHandle As Integer
If thisWindow = _FrontWindow() Then
GrayRgnHandle=Lpeek(&H9EE) ' Global variable
_DragWindow(thisWindow,event_where,Lpeek(GrayRgnHandle)+2)
Endif
Return
*********************************************************
* *
* Update Event *
*********************************************************
Procedure UpdateEvent()
Local windowPtr As Integer
windowPtr=event_message
_SetPort(windowPtr)
_BeginUpdate(windowPtr)
_DrawDialog(windowPtr)
_UpdateControls(windowPtr,Lpeek(windowPtr+24)) ' visRgn
_EndUpdate(windowPtr)
Return
*********************************************************
* *
* Mouse Down in Window *
*********************************************************
Procedure MouseDownInWindow(thisWindow,Done)
Parameter thisWindow As Integer
Parameter Done As Integer Byref
Local windowType As Integer
Local DialogPtr As Integer
Local itemHit As Word
Local Ret As Byte
If thisWindow <> _FrontWindow() Then
* Make this window active if it is not already
_SelectWindow(thisWindow)
Else
* Find out if mouse down was in a control and if so which one
Ret=_DialogSelect(EventRecord,Varptr(DialogPtr),Varptr(itemHit))
If Integer(Ret)=1
If Integer(itemHit)=5 ' the Button
Done=-1
Endif
Endif
Endif
Return
*********************************************************
* *
* Process File *
*********************************************************
Procedure Process_File()
Local Command As Integer
Local AppStruct As Structure
Local AvRefNum As Word
Local Atype As Integer
Local AversNum As Byte
Local Afiller As Byte
Local AfileName As Str255 [64]
Endstruct
* find out if we have been asked to open a file or print a file
Command=GetAppMessage()
Do Case
Case Command=0 ' Open file
* get details of the file to open (first one only)
AppStruct=GetAppFile(1)
Do Show_File_Details(Integer(AvRefNum),String(AfileName))
Break
Case Command=1 ' Print file
* reject as this program does not print files
Print "FileInfo does not print files"
Inkey
Endcase
Return
*********************************************************
* *
* Show File Details *
*********************************************************
Procedure Show_File_Details(RefNum,fileName)
Parameter RefNum As Integer
Parameter fileName As String
Local Ret As Word
Local fName As Str255
Local paramBlock As Structure
Local Filler1 As Char [12]
Local ioCompletion As Integer
Local ioResult As Word
Local ioNamePtr As Integer
Local ioVRefNum As Word
Local ioFRefNum As Word
Local ioFVersNum As Byte
Local Filler2 As Byte
Local ioFDirIndex As Word
Local ioFlAttrib As Byte
Local Filler3 As Byte
Local pFInfo As Char [16]
Local ioDirID As Integer
Local Filler4 As Char [56]
Endstruct
Local FInfo As Structure
Local fdType as Integer
Local fdCreator As Integer
Local fdFlags As Word
Local fdLocation As Integer
Local fdFldr As Word
Endstruct
Local UserItemType As Word
Local DialogItem As Integer
Local UserItemRect As Structure
Local R1 As Word
Local R2 As Word
Local R3 As Word
Local R4 As Word
Endstruct
* Set up paramBlock for PBGetCatInfo call
ioCompletion=0
fName=Str255(fileName)
ioNamePtr=Varptr(fName)
ioVRefNum=Word(RefNum)
ioFDirIndex=0
ioDirID=0
Ret=_PBGetCatInfo(paramBlock)
If Integer(Ret)=0
FInfo=pFInfo
* Get Handle to Dialog Item 3. (File type box)
UserItemType=Word(16) ' Editable Text
DialogItem=0 ' Dont know why we have to set this
_GetDialogItem(DialogPtr,Word(3),Varptr(UserItemType),Varptr(DialogItem),UserItemRect)
* Set Dialog Item 3 to File Type string
_SetDialogItemText(DialogItem,Str255(IntToChars(fdType)))
* Get Handle to Dialog Item 4. (Creator box)
UserItemType=Word(16)
DialogItem=0
_GetDialogItem(DialogPtr,Word(4),Varptr(UserItemType),Varptr(DialogItem),UserItemRect)
* Set Dialog Item 4 to Creator string
_SetDialogItemText(DialogItem,Str255(IntToChars(fdCreator)))
Else
Print "Error in PBGetCatInfo ";Ret
Inkey
Endif
Return
*********************************************************
* *
* Convert Integer to Chars *
*********************************************************
Function IntToChars(InInt) Returning String
Parameter InInt As Integer
Local I As Integer
Local ChString As String [4]
* File types and Creator types are stored as a 32 bit integer with 4
* characters encoded within each byte. Use peek and carptr to get each byte.
ChString=""
For I=1 to 4
ChString=ChString+Chr(Peek(Varptr(InInt)+I-1))
Next I
Return ChString